home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 16 / 016.d81 / cribbage sol (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1985-01-01  |  13.1 KB  |  460 lines
  1. 10 rem **********************
  2. 12 rem *                    *
  3. 14 rem * cribbage solitaire *
  4. 15 rem *   (commodore 64)   *
  5. 16 rem *        by          *
  6. 17 rem * chris constantinou *
  7. 18 rem *   february 1984    *
  8. 19 rem *                    *
  9. 20 rem **********************
  10. 70 lh=999:lc=999
  11. 80 poke53280,11:poke53281,15
  12. 90 def fnb(x)=int(x*10+.5)/10
  13. 95 poke54296,15:poke54277,68:poke54273,63:poke54272,75
  14. 110 dima(54),de(54),a$(11),rr$(13),v(13),r(13)
  15. 120 fori=1to13:readrr$(i):nexti
  16. 130 fori=1to13:readv(i):nexti
  17. 135 fori=1to13:readr(i):nexti
  18. 140 data a,2,3,4,5,6,7,8,9,10,j,q,k
  19. 150 data 1,2,3,4,5,6,7,8,9,10,10,10,10
  20. 155 data 1,2,3,4,5,6,7,8,9,10,11,12,13
  21. 160 print"[147]                                       [146]"
  22. 161 print"           cribbage solitaire          [146]"
  23. 162 print"                                       [146]"
  24. 164 print"           do you wish to see"
  25. 165 printtab(16)"playing"
  26. 167 printtab(10)"[207][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][208]"
  27. 168 printtab(10)"[165]if yes,enter y or [167]"
  28. 170 printtab(10)"[165]hit return[146] to play[167]"
  29. 171 printtab(10)"[204][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][186]"
  30. 173 input"[145][145][145][145][145][145][145]            instructions  n[157][157][157]";a$
  31. 175 ifleft$(a$,1)="y"thengosub2600
  32. 178 print"[147]                                       [146]"
  33. 179 print"           cribbage solitaire          [146]"
  34. 180 print"                                       [146]"
  35. 181 print"      shuffling the deck of cards"
  36. 182 printtab(13)"is in process"
  37. 185 fori=1to52:a(i)=i:nexti:i=1:cc=0:s=1:gt=0:hl=0:cl=0
  38. 190 forw=1to6:rem deal random cards to crib
  39. 200 cd=0:fori=itoi+1
  40. 220 gosub1005:rem deal random cards to crib
  41. 230 ifde(i)>39then270
  42. 240 ifde(i)>26then280
  43. 250 ifde(i)>13then290
  44. 260 r=de(i):sc$(cd)="[211]":goto295
  45. 270 r=de(i)-39:sc$(cd)="[193]":goto295
  46. 280 r=de(i)-26:sc$(cd)="[216]":goto295
  47. 290 r=de(i)-13:sc$(cd)="[218]"
  48. 295 rc$(cd)=rr$(r):rc(cd)=r(r):vc(cd)=v(r):nexti
  49. 395 rem *** deal hand ***
  50. 400 cd=0:fori=itoi+5
  51. 410 gosub1005:rem ** deal random cards **
  52. 420 ifde(i)>39then460
  53. 430 ifde(i)>26then470
  54. 440 ifde(i)>13then480
  55. 450 r=de(i):s$(cd)="[211]":goto485
  56. 460 r=de(i)-39:s$(cd)="[193]":goto485
  57. 470 r=de(i)-26:s$(cd)="[216]":goto485
  58. 480 r=de(i)-13:s$(cd)="[218]"
  59. 485 r$(cd)=rr$(r):rh(cd)=r(r):vh(cd)=v(r)
  60. 490 ifi=53then494
  61. 492 goto500
  62. 494 r$(6)=tr$(1):s$(6)=ts$(1):rh(6)=tr(1):vh(6)=tv(1):i=54
  63. 500 nexti
  64. 600 print"[147]":cc=0:d=6:gosub1045:rem ** sort hand of cards **
  65. 610 forl=1to6
  66. 620 r$=r$(l):s$=s$(l):r=rh(l)
  67. 630 c$="":ifr$="10"thenc$="[157]"
  68. 640 gosub1215:rem ** build graphics zone **
  69. 650 onrgosub1300,1350,1400,1450,1500,1550,1600,1650,1700,1750,1800,1850,1900
  70. 654 rem ** print card **
  71. 660 print"";:ifl<4thentb=cc*8+4:printtab(tb);l
  72. 661 ifs$="[211]"ors$="[218]"thenprint"";:goto663
  73. 662 print"[144]";
  74. 663 ifl<4then666
  75. 664 ifl=4thencc=0:print""
  76. 665 tb=cc*8+10
  77. 666 poke54276,129:forj=1to11:printtab(tb);a$(j):nextj:print"";:poke54276,128
  78. 667 ifl>3thenprinttab(tb);l
  79. 668 cc=cc+1:print"[145][145][145][145][145][145][145][145][145][145][145][145][145]":nextl:print""tab(30)"hand"w"[157][157][157]#[146]"
  80. 670 print"";
  81. 671 printtab(11)"select 2 cards for"
  82. 672 printtab(11)"crib."
  83. 673 printtab(11)"game points:[151]";gt
  84. 674 printtab(18)"[145][145][145]1st: [164]         [157][157][157][157][157][157][157][157][157][157]";
  85. 675 poke198,0:wait198,1:getc1$:ifc1$="0"then63000
  86. 676 ifval(c1$)<1orval(c1$)>6then675
  87. 677 :
  88. 678 printc1$"  2nd: [164][157]";:c1=val(c1$)
  89. 679 getc2$:ifval(c2$)<1orval(c2$)>6orc2$=c1$then679
  90. 680 printc2$:c2=val(c2$)
  91. 683 print"     [218] hit <return>[146] to score hand [218]";
  92. 685 geta$:ifa$=""then685
  93. 686 ifa$=chr$(20)ora$=chr$(157)then670
  94. 687 ifa$<>chr$(13)then685
  95. 690 cd=3:k=1:forj=1to6
  96. 695 ifj=c1orj=c2thenrc$(cd)=r$(j):sc$(cd)=s$(j):rc(cd)=rh(j):goto700
  97. 698 goto705
  98. 700 vc(cd)=vh(j):cd=cd+1:goto708
  99. 705 rs$(k)=r$(j):ss$(k)=s$(j):rs(k)=rh(j):vs(k)=vh(j):k=k+1
  100. 708 nextj
  101. 710 fork=1to4:r$(k)=rs$(k):s$(k)=ss$(k):rh(k)=rs(k):vh(k)=vs(k):nextk
  102. 720 ifw=6thentr$=tr$(2):ts$=ts$(2):tr=tr(2):tv=tv(2):goto760
  103. 722 gosub1005:rem ** deal turn-up **
  104. 725 ifde(i)>39then745
  105. 730 ifde(i)>26then750
  106. 735 ifde(i)>13then755
  107. 740 r=de(i):ts$="[211]":goto757
  108. 745 r=de(i)-39:ts$="[193]":goto757
  109. 750 r=de(i)-26:ts$="[216]":goto757
  110. 755 r=de(i)-13:ts$="[218]"
  111. 757 tr$=rr$(r):tr=r(r):tv=v(r)
  112. 760 i=i+1:r$(5)=tr$:s$(5)=ts$:rh(5)=tr:vh(5)=tv
  113. 770 d=5:gosub1045:rem ** sort hand of 5 **
  114. 775 sw=0:gosub2000:rem ** score hand **
  115. 780 gosub2310:rem ** score flush in hand **
  116. 782 c$="[157]":print"[147]"tab(15)" hand #";w;c$;" [146]"
  117. 785 cc=0:forl=1to5:r$=r$(l):s$=s$(l):r=rh(l)
  118. 788 c$="":ifr$="10"thenc$="[157]"
  119. 790 gosub1215:rem ** graphics **
  120. 795 onrgosub1300,1350,1400,1450,1500,1550,1600,1650,1700,1750,1800,1850,1900
  121. 796 ifs$="[211]"ors$="[218]"thenprint"";:goto798
  122. 797 print"[144]";
  123. 798 tb=cc*6+3:poke54276,129:forj=1to11:printtab(tb);a$(j):nextj:poke54276,128
  124. 800 cc=cc+1:print"[145][145][145][145][145][145][145][145][145][145][145][145]":nextl:print"";
  125. 802 print""
  126. 804 printtab(10)"turn-up is:      ";:tc$="[144]":ifts$="[218]"orts$="[211]"thentc$=""
  127. 805 printtc$+tr$+ts$+""
  128. 806 printtab(10)"points in hand: ";tp
  129. 808 printtab(10)"game points:    [151]";gt
  130. 815 printtab(4)"[218] hit <return>[146] to score crib [218]";
  131. 817 geta$:ifa$=""then817
  132. 820 ifa$<>chr$(13)then817
  133. 825 rem ** move crib var.to hand **
  134. 830 forx=1to4:r$(x)=rc$(x):s$(x)=sc$(x):rh(x)=rc(x):vh(x)=vc(x):nextx
  135. 832 r$(5)=tr$:s$(5)=ts$:rh(5)=tr:vh(5)=tv
  136. 835 d=5:gosub1045:rem ** sort crib of 5 **
  137. 836 sw=1:gosub2000:rem ** score crib **
  138. 837 gosub2400:rem ** score flush **
  139. 838 c$="[157]":print"[147]"tab(15)" crib #";w;c$;" [146]"
  140. 840 cc=0:tb=0:forl=1to5
  141. 845 r$=r$(l):s$=s$(l):r=rh(l):c$="":ifr$="10"thenc$="[157]"
  142. 850 gosub1215:rem ** graphics **
  143. 852 onrgosub1300,1350,1400,1450,1500,1550,1600,1650,1700,1750,1800,1850,1900
  144. 853 ifs$="[211]"ors$="[218]"thenprint"";:goto856
  145. 854 print"[144]";
  146. 856 tb=cc*6+3:poke54276,129:forj=1to11:printtab(tb);a$(j):nextj:poke54276,128
  147. 858 cc=cc+1:print"[145][145][145][145][145][145][145][145][145][145][145][145]":nextl:print"";
  148. 861 printtab(10)"turn-up is:      ";tc$+tr$+ts$+""
  149. 862 printtab(10)"points in crib: ";tp
  150. 863 printtab(10)"game points:    [151]";gt
  151. 864 print" [218] hit <return>[146] to deal another hand [218]";
  152. 865 geta$:ifa$=""then865
  153. 867 ifa$<>chr$(13)then865
  154. 870 rem ** store turn-up in hold **
  155. 880 tr$(s)=tr$:ts$(s)=ts$:tr(s)=tr:tv(s)=tv:s=s+1
  156. 890 nextw
  157. 900 rem *** last hand ***
  158. 905 forx=2to5:r$(x-1)=tr$(x):s$(x-1)=ts$(x):rh(x-1)=tr(x):vh(x-1)=tv(x):nextx
  159. 910 r$(5)="":s$(5)="":rh(5)=15:vh(5)=15
  160. 920 d=4:gosub1045:rem ** sort last hand **
  161. 930 print"[147]"
  162. 935 gosub2000:rem ** score hand of 4 **
  163. 937 gosub2310:rem ** score flush **
  164. 939 print"[147]"tab(14)" last hand [146]"
  165. 940 cc=0:forl=1to4
  166. 945 r$=r$(l):s$=s$(l):r=rh(l):c$="":ifr$="10"thenc$="[157]"
  167. 950 gosub1215:rem ** graphics **
  168. 955 onrgosub1300,1350,1400,1450,1500,1550,1600,1650,1700,1750,1800,1850,1900
  169. 957 ifs$="[211]"ors$="[218]"thenprint"";:goto960
  170. 958 print"[144]";
  171. 960 tb=cc*6+6:poke54276,129:forj=1to11:printtab(tb);a$(j):nextj:poke54276,128
  172. 962 cc=cc+1:print"[145][145][145][145][145][145][145][145][145][145][145][145]":nextl
  173. 965 printtab(13)"last hand:";tp
  174. 966 printtab(11)"game points:[151]";gt
  175. 968 print"  [218] hit <return>[146] to view game totals [218]";
  176. 970 geta$:ifa$=""then970
  177. 971 ifa$<>chr$(13)then970
  178. 972 ifgt>ghthengh=gt
  179. 973 gc=gc+1:ga=ga+gt
  180. 980 print"[147][154]"tab(7)"[213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]"
  181. 981 printtab(7)"[194]   cribbage solitaire[154]   [221]"
  182. 982 printtab(7)"[194]  statistical averages[154]  [221]"
  183. 984 printtab(7)"[202][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][203] "
  184. 985 printtab(9)"game points  :    ";gt
  185. 986 printtab(9)"last avg/hand:    ";fnb(hl/6):iffnb(hl/6)>hhthenhh=fnb(hl/6)
  186. 987 printtab(9)"last avg/crib:    ";fnb(cl/6):iffnb(cl/6)>hcthenhc=fnb(cl/6)
  187. 988 printtab(9)"average/game :    ";fnb(ga/gc)
  188. 989 printtab(9)"average/hand :    ";fnb(ha/6/gc)
  189. 990 printtab(9)"average/crib :    ";fnb(ca/6/gc)
  190. 991 printtab(9)"high avg/hand:    ";hh:iffnb(hl/6)<lhthenlh=fnb(hl/6)
  191. 992 printtab(9)"high avg/crib:    ";hc:iffnb(cl/6)<lcthenlc=fnb(cl/6)
  192. 993 printtab(9)"low avg/hand :    ";lh
  193. 994 printtab(9)"low avg/crib :    ";lc
  194. 995 printtab(9)"games played :    "gc:printtab(9)"game high    :    [151]"gh
  195. 996 print:print"  do you want to print your results?"
  196. 997 geta$:ifa$<>"y"anda$<>"n"then997
  197. 998 ifa$="y"thengosub2800:goto63000
  198. 999 goto63000
  199. 1000 goto160
  200. 1005 v=int((53-i)*rnd(0)+1)
  201. 1010 de(i)=a(v):cd=cd+1
  202. 1020 forj=vto(52-i):a(j)=a(j+1):nextj
  203. 1030 return
  204. 1040 rem *** sort subroutine ***
  205. 1045 form=1tod-1
  206. 1050 forn=1tod-1
  207. 1055 ifrh(n)<rh(n+1)then1065
  208. 1060 nextn:nextm:return
  209. 1065 r=rh(n):rh(n)=rh(n+1):rh(n+1)=r
  210. 1070 r$=r$(n):r$(n)=r$(n+1):r$(n+1)=r$
  211. 1075 s$=s$(n):s$(n)=s$(n+1):s$(n+1)=s$
  212. 1080 v=vh(n):vh(n)=vh(n+1):vh(n+1)=v
  213. 1085 goto1060
  214. 1200 rem ** graphics build area **
  215. 1215 a$(1)="[207][183][183][183][183][183][183][183][208]"
  216. 1220 a$(2)="[165]"+r$+" "+c$+"     [167]"
  217. 1225 ifr(l)=11orr(l)=12orr(l)=13then1240
  218. 1230 a$(3)="[165]"+s$+"      [167]"
  219. 1235 a$(9)="[165]      "+s$+"[167]"
  220. 1240 a$(10)="[165]      "+c$+r$+"[167]"
  221. 1245 a$(11)="[204][175][175][175][175][175][175][175][186]"
  222. 1250 return
  223. 1300 a$(4)="[165]       [167]"
  224. 1305 a$(5)="[165]       [167]"
  225. 1310 a$(6)="[165]   "+s$+"   [167]"
  226. 1315 a$(7)="[165]       [167]"
  227. 1320 a$(8)="[165]       [167]"
  228. 1325 return
  229. 1350 a$(4)="[165]   "+s$+"   [167]"
  230. 1355 a$(5)="[165]       [167]"
  231. 1360 a$(6)="[165]       [167]"
  232. 1365 a$(7)="[165]       [167]"
  233. 1370 a$(8)="[165]   "+s$+"   [167]"
  234. 1375 return
  235. 1400 a$(4)="[165]   "+s$+"   [167]"
  236. 1405 a$(5)="[165]       [167]"
  237. 1410 a$(6)="[165]   "+s$+"   [167]"
  238. 1415 a$(7)="[165]       [167]"
  239. 1420 a$(8)="[165]   "+s$+"   [167]"
  240. 1425 return
  241. 1450 a$(4)="[165] "+s$+"   "+s$+" [167]"
  242. 1455 a$(5)="[165]       [167]"
  243. 1460 a$(6)="[165]       [167]"
  244. 1465 a$(7)="[165]       [167]"
  245. 1470 a$(8)="[165] "+s$+"   "+s$+" [167]"
  246. 1475 return
  247. 1500 a$(4)="[165] "+s$+"   "+s$+" [167]"
  248. 1505 a$(5)="[165]       [167]"
  249. 1510 a$(6)="[165]   "+s$+"   [167]"
  250. 1515 a$(7)="[165]       [167]"
  251. 1520 a$(8)="[165] "+s$+"   "+s$+" [167]"
  252. 1525 return
  253. 1550 a$(4)="[165] "+s$+"   "+s$+" [167]"
  254. 1555 a$(5)="[165]       [167]"
  255. 1560 a$(6)="[165] "+s$+"   "+s$+" [167]"
  256. 1565 a$(7)="[165]       [167]"
  257. 1570 a$(8)="[165] "+s$+"   "+s$+" [167]"
  258. 1575 return
  259. 1600 a$(4)="[165] "+s$+"   "+s$+" [167]"
  260. 1605 a$(5)="[165]   "+s$+"   [167]"
  261. 1610 a$(6)="[165] "+s$+"   "+s$+" [167]"
  262. 1615 a$(7)="[165]       [167]"
  263. 1620 a$(8)="[165] "+s$+"   "+s$+" [167]"
  264. 1625 return
  265. 1650 a$(4)="[165] "+s$+"   "+s$+" [167]"
  266. 1655 a$(5)="[165]   "+s$+"   [167]"
  267. 1660 a$(6)="[165] "+s$+"   "+s$+" [167]"
  268. 1665 a$(7)="[165]   "+s$+"   [167]"
  269. 1670 a$(8)="[165] "+s$+"   "+s$+" [167]"
  270. 1675 return
  271. 1700 a$(4)="[165] "+s$+"   "+s$+" [167]"
  272. 1705 a$(5)="[165] "+s$+"   "+s$+" [167]"
  273. 1710 a$(6)="[165]   "+s$+"   [167]"
  274. 1715 a$(7)="[165] "+s$+"   "+s$+" [167]"
  275. 1720 a$(8)="[165] "+s$+"   "+s$+" [167]"
  276. 1725 return
  277. 1750 a$(4)="[165] "+s$+"   "+s$+" [167]"
  278. 1755 a$(5)="[165] "+s$+"   "+s$+" [167]"
  279. 1760 a$(6)="[165] "+s$+"   "+s$+" [167]"
  280. 1765 a$(7)="[165] "+s$+"   "+s$+" [167]"
  281. 1770 a$(8)="[165] "+s$+"   "+s$+" [167]"
  282. 1775 return
  283. 1800 a$(3)="[165]"+s$+"[146][166][166] [215][180][187][146][167]"
  284. 1805 a$(4)="[165] [146][166][220] [213] [161][146][167]"
  285. 1810 a$(5)="[165] [146]"+s$+"  [207][223][161][146][167]"
  286. 1815 a$(6)="[165][172][146][192][192][192][192][192][190][146][167]"
  287. 1820 a$(7)="[165][161][223][146][186]  "+s$+" [146][167]"
  288. 1825 a$(8)="[165][161] [146][203] [168][166] [146][167]"
  289. 1830 a$(9)="[165][188][170][146][215] [166][166]"+s$+"[146][167]"
  290. 1835 return
  291. 1850 a$(3)="[165]"+s$+"[146][166][166] [215][180] [146][167]"
  292. 1855 a$(4)="[165] [146][166][220] [202]  [146][167]"
  293. 1860 a$(5)="[165] [146]"+s$+"  [207][223][187][146][167]"
  294. 1865 a$(6)="[165][172][146][192][192][192][192][192][190][146][167]"
  295. 1870 a$(7)="[165][188][223][146][186]  "+s$+" [146][167]"
  296. 1875 a$(8)="[165]  [146][201] [168][166] [146][167]"
  297. 1880 a$(9)="[165] [167][146][215] [166][166]"+s$+"[146][167]"
  298. 1885 return
  299. 1900 a$(3)="[165]"+s$+"[170][146][215] [166][166] [146][167]"
  300. 1905 a$(4)="[165][161] [146][201] [207][166] [146][167]"
  301. 1910 a$(5)="[165][161][169][208]  "+s$+" [146][167]"
  302. 1915 a$(6)="[165][188][146][192][192][192][192][192][187][146][167]"
  303. 1920 a$(7)="[165] [146]"+s$+"  [204][169][161][146][167]"
  304. 1925 a$(8)="[165] [146][166][186] [202] [161][146][167]"
  305. 1930 a$(9)="[165] [146][166][166] [215][180]"+s$+"[146][167]"
  306. 1935 return
  307. 1995 rem *** scoring ***
  308. 1996 rem
  309. 1997 rem ** 15 comb. **
  310. 2000 p1=0:p2=0:p3=0:p4=0:p5=0:p6=0:tp=0:k=1
  311. 2010 forx=k+1to5
  312. 2015 ifvh(k)+vh(x)=15thenp1=p1+2
  313. 2020 nextx
  314. 2025 ifk=4then2035
  315. 2030 k=k+1:goto2010
  316. 2035 forx=3to5
  317. 2040 ifvh(1)+vh(2)+vh(x)=15thenp1=p1+2
  318. 2045 nextx
  319. 2050 forx=4to5
  320. 2055 ifvh(1)+vh(3)+vh(x)=15thenp1=p1+2
  321. 2060 ifvh(2)+vh(3)+vh(x)=15thenp1=p1+2
  322. 2065 ifvh(1)+vh(2)+vh(3)+vh(x)=15thenp1=p1+2
  323. 2070 nextx
  324. 2075 forx=1to3
  325. 2080 ifvh(x)+vh(4)+vh(5)=15thenp1=p1+2
  326. 2082 nextx
  327. 2085 forx=2to3
  328. 2086 ifvh(1)+vh(x)+vh(4)+vh(5)=15thenp1=p1+2
  329. 2087 nextx
  330. 2090 ifvh(2)+vh(3)+vh(4)+vh(5)=15thenp1=p1+2
  331. 2095 ifvh(1)+vh(2)+vh(3)+vh(4)+vh(5)=15thenp1=p1+2
  332. 2097 rem * pairs scoring *
  333. 2100 k=1
  334. 2105 forx=k+1to5
  335. 2110 ifrh(k)=rh(x)thenp2=p2+2
  336. 2115 nextx
  337. 2120 ifk=4then2135
  338. 2125 k=k+1:goto2105
  339. 2130 rem * seq. scoring *
  340. 2135 forx=1to6:sq(x)=20:nextx
  341. 2140 x=1:k=1:sq(x)=rh(k):x=x+1
  342. 2145 fork=kto4
  343. 2150 ifrh(k)<>rh(k+1)thensq(x)=rh(k+1):x=x+1
  344. 2155 nextk
  345. 2160 forx=1to5:hq(x)=15:nextx:k=1:x=1
  346. 2165 ifsq(k)=20then2268
  347. 2170 ifsq(k)=sq(k+1)+1then2180
  348. 2175 k=k+1:goto2165
  349. 2180 ifsq(k)=sq(k+2)+2thenp3=p3+3:forx=1to3:hq(x)=sq(k+x-1):nextx:goto2190
  350. 2185 k=k+1:goto2165
  351. 2190 ifsq(k)=sq(k+3)+3thenp3=p3+1:hq(x)=sq(k+3):goto2200
  352. 2195 goto2205
  353. 2200 ifsq(k)=sq(k+4)+4thenp3=p3+1
  354. 2205 x=1:z=0:pr=0
  355. 2210 fory=1to4
  356. 2215 fork=xto5
  357. 2220 ifhq(x)=rh(k)thenz=z+1
  358. 2225 nextk
  359. 2230 ifz=2thenpr=pr+1
  360. 2235 ifz=3thenpr=pr+3
  361. 2240 x=x+1:z=0
  362. 2245 nexty
  363. 2250 ifpr=1thenp3=p3*2
  364. 2255 ifpr=2thenp3=p3*4
  365. 2260 ifpr=3thenp3=p3*3
  366. 2265 rem * nibs scoring *
  367. 2268 ifw=7then2303
  368. 2270 forx=1tod
  369. 2275 ifrh(x)=11then2285
  370. 2280 goto2290
  371. 2285 ifs$(x)=ts$thenp4=p4+1
  372. 2290 nextx
  373. 2295 rem * jack scoring *
  374. 2296 iftr=11thenp4=0
  375. 2297 ifsw=1then2303
  376. 2300 iftr=11thenp5=2
  377. 2303 return
  378. 2305 rem * flush scoring *
  379. 2310 k=1:forx=1to5:h$(x)=str$(x):nextx
  380. 2315 forx=1to5
  381. 2320 ifs$(x)=ts$then2330
  382. 2325 h$(k)=s$(x):k=k+1
  383. 2330 nextx
  384. 2335 z=1:ifk=1thenp6=5
  385. 2340 fork=1to3
  386. 2345 ifh$(k)=h$(k+1)thenz=z+1
  387. 2350 nextk
  388. 2355 ifz=4thenp6=4:goto2365
  389. 2360 goto2370
  390. 2365 ifh$(k)=ts$thenp6=5
  391. 2370 tp=p1+p2+p3+p4+p5+p6
  392. 2375 gt=gt+tp:ha=ha+tp:hl=hl+tp
  393. 2380 return
  394. 2400 rem * crib flush scoring *
  395. 2405 z=1
  396. 2410 forx=1to4
  397. 2415 ifs$(x)=s$(x+1)thenz=z+1
  398. 2420 nextx
  399. 2425 ifz=5thenp6=5
  400. 2430 tp=p1+p2+p3+p4+p5+p6
  401. 2435 ifw<7thengt=gt+tp:ca=ca+tp:cl=cl+tp
  402. 2440 return
  403. 2600 print"[147]object of the game is to score as many"
  404. 2602 print"points as possible using the entire deck";
  405. 2604 print"of cards.  multiple games can be played"
  406. 2606 print"in which the computer maintains the game";
  407. 2608 print"averages, no. of games played, game"
  408. 2610 print"high, etc."
  409. 2620 print"points are scored in the following ways:";
  410. 2622 print" * each 15 combination    2 pts.      [146]"
  411. 2624 print" * each pair              2 pts.      [146]"
  412. 2626 print" * each run (3 or more)   1 pt./card  [146]"
  413. 2628 print" * jack as turn-up card   2 pts.      [146]"
  414. 2630 print" * turn-up suit matches               [146]"
  415. 2632 print"     jack in hand         1 pt.       [146]"
  416. 2634 print" * flush of 4 or 5        1 pt./card  [146]"
  417. 2640 print"special notes:"
  418. 2642 print" [218] face cards hold a value of 10 when"
  419. 2644 print"     scoring 15 combinations"
  420. 2646 print" [218] rank (low to high) is a,2,3...10,j,"
  421. 2648 print"     q,k in runs of 3 or more."
  422. 2650 print" [218] flush in hand may be 4 or 5 cards,"
  423. 2652 print"     but crib must be 5 to be scored."
  424. 2654 print"      hit <return>[146] for next page";
  425. 2656 geta$:ifa$=""then2656
  426. 2658 ifa$<>chr$(13)then2656
  427. 2660 print"[147]the points are calculated automatically"
  428. 2662 print"for you in this game. therefore,"
  429. 2664 print"experience will teach you to understand"
  430. 2666 print"how the points are counted."
  431. 2670 print"you must select 2 cards for a second"
  432. 2672 print"hand called a crib (hence the name"
  433. 2674 print"cribbage). you will be able to score"
  434. 2676 print"these cards later just as you do in a"
  435. 2678 print"hand. to select, use the reference no."
  436. 2680 print"that pertains to the desired card. after";
  437. 2682 print"selection is made, a turn-up card is"
  438. 2684 print"dealt. it is to be used in scoring both"
  439. 2686 print"the hand and crib."
  440. 2690 print"six rounds including last 4 cards are"
  441. 2692 print"played to complete one game. a total of"
  442. 2694 print"121 pt. is a winning score."
  443. 2696 print"[218] hint: the 2nd round turn-up card"
  444. 2698 print"appears again in the 6th round."
  445. 2700 print"       hit <return>[146] to play game";
  446. 2705 geta$:ifa$=""then2705
  447. 2708 ifa$<>chr$(13)then2705
  448. 2710 return
  449. 2800 open4,4:cmd4:fori=1to20:forj=1to33
  450. 2810 pk=peek(1023+i*40+j):ifpk<32thenpk=pk+64:goto2830
  451. 2820 ifpk>63thenpk=pk+32
  452. 2830 print#4,chr$(14)chr$(pk);:nextj:print#4:nexti
  453. 2840 print#4,chr$(15);chr$(12);: close4:     return
  454. 63000 rem   play again?
  455. 63010 print"[147]do you want to play again?"
  456. 63020 poke198,0:wait198,1:geta$:ifa$<>"y"anda$<>"n"then63020
  457. 63030 ifa$="y"then 178
  458. 63040 print"[147]load"chr$(34)"payload"chr$(34)",8":print"run"
  459. 63050 poke631,13:poke632,13:poke198,2:        end
  460.